Workbench Add-On/Workbench Add-On - Volume 1.iso/BBS-Archive/Dev/Obrn-A_1.6_lib.lha/oberon-a/source3.lha/source/Library/Strings2.mod

Text File | 1995-06-29 | 5KB | 217 lines

(***************************************************************************

     $RCSfile: Strings2.mod $
  Description: More string manipulation

   Created by: fjc (Frank Copeland)
    $Revision: 1.5 $
      $Author: fjc $
        $Date: 1995/06/29 19:04:45 $

  Copyright © 1994-1995, Frank Copeland.
  This file is part of the Oberon-A Library.
  See Oberon-A.doc for conditions of use and distribution.

***************************************************************************)

<*$ IndexChk- *>

(* Index checking is handled explicitly by the relevant procedures. *)

MODULE Strings2;

IMPORT SYS := SYSTEM, Strings;

PROCEDURE Min ( a, b : INTEGER ) : INTEGER;
BEGIN (* Min *)
  IF a < b THEN RETURN a
  ELSE RETURN b
  END
END Min;


PROCEDURE Max ( a, b : INTEGER ) : INTEGER;
BEGIN (* Max *)
  IF a > b THEN RETURN a
  ELSE RETURN b
  END
END Max;


(*------------------------------------*)
PROCEDURE OverWrite *
  ( source     : ARRAY OF CHAR;
    pos      : INTEGER;
    VAR dest : ARRAY OF CHAR );
(*
  Overwrites the contents of "dest" with "source", starting at "pos".
  Truncates where necessary.
*)

  VAR len : INTEGER;

<*$CopyArrays-*>
BEGIN (* OverWrite *)
  len := Min (Strings.Length (source), Strings.Length (dest) - pos);
  IF len > 0 THEN
    SYS.MOVE (SYS.ADR (source), SYS.ADR (dest [pos]), len)
  END
END OverWrite;


(*------------------------------------*)
PROCEDURE OverWriteSubString *
  ( source          : ARRAY OF CHAR;
    start, len, pos : INTEGER;
    VAR dest        : ARRAY OF CHAR );
(*
  Overwrites the contents of dest [pos ...] with source [start ..
  (start + len - 1)]. Truncates or extends where necessary.
*)

  VAR len2 : INTEGER;

<*$CopyArrays-*>
BEGIN (* OverWriteSubString *)
  len2 :=
    Min (Min (len, Strings.Length (source) - start), Strings.Length (dest) - pos );
  IF len2 > 0 THEN
    SYS.MOVE (SYS.ADR (source), SYS.ADR (dest [pos]), len2)
  END
END OverWriteSubString;


(*------------------------------------*)
PROCEDURE FindChar *
  ( char : CHAR;
    str  : ARRAY OF CHAR;
    pos  : INTEGER )
  : INTEGER;
(*
  Searches "str" for the first occurrence of "char", starting at "pos"
  and returns its position if found, otherwise it returns -1.
*)

  VAR lim : INTEGER;

<*$CopyArrays-*>
BEGIN (* FindChar *)
  lim := Strings.Length (str);
  WHILE (pos < lim) & (str [pos] # char) DO
    INC(pos);
  END;
  IF pos = lim THEN RETURN -1 ELSE RETURN pos END
END FindChar;


(*------------------------------------*)
PROCEDURE CompareCAP *
  ( str1, str2 : ARRAY OF CHAR )
  : SHORTINT;
(*
  Returns the result of the lexical comparison of the two strings. Returns
  -1 if (str1 < str2), 0 if (str1 = str2) and 1 if
  (str1 > str2). The case of the strings is ignored.
*)

  VAR
    len1, len2, index, lim : INTEGER;
    result : SHORTINT; ch1, ch2 : CHAR;

<*$CopyArrays-*>
BEGIN (* CompareCAP *)
  len1 := Strings.Length (str1); len2 := Strings.Length (str2);
  lim := Min (len1, len2); index := 0;
  LOOP
    IF (index = lim) THEN
      IF (len1 < len2) THEN result := -1;
      ELSIF (len1 > len2) THEN result := 1;
      ELSE result := 0;
      END;
      EXIT;
    END;
    ch1 := CAP (str1 [index]); ch2 := CAP (str2 [index]);
    IF ch1 < ch2 THEN result := -1; EXIT
    ELSIF ch1 > ch2 THEN result := 1; EXIT
    END;
    INC (index);
  END;
  RETURN result;
END CompareCAP;


(*------------------------------------*)
PROCEDURE TrimLeft *
  ( char : CHAR;
    VAR str : ARRAY OF CHAR );
(*
  Deletes any instances of "char" from the start of "str".
*)

  VAR len : INTEGER;

BEGIN (* TrimLeft *)
  len := 0; WHILE (str [len] = char) DO INC (len) END;
  IF len > 0 THEN Strings.Delete (str, 0, len) END
END TrimLeft;


(*------------------------------------*)
PROCEDURE TrimRight *
  ( char : CHAR;
    VAR str : ARRAY OF CHAR );
(*
  Deletes any instances of "char" from the end of "str".
*)

  VAR pos : INTEGER;

BEGIN (* TrimRight *)
  pos := Strings.Length (str) - 1;
  WHILE (str [pos] = char) DO DEC (pos) END;
  str [pos] := 0X;
END TrimRight;


(*------------------------------------*)
PROCEDURE Fill *
  ( char       : CHAR;
    pos, len : INTEGER;
    VAR str : ARRAY OF CHAR );
(*
  Fills str with char, beginning at pos character for len
  characters.
*)

  VAR len2 : INTEGER;

BEGIN (* Fill *)
  IF pos < (SHORT (LEN (str)) - 1) THEN
    len := Min (len, SHORT (LEN (str)) - pos - 1);
    len2 := Max (Strings.Length (str), pos + len);
    WHILE len > 0 DO
      str [pos] := char; INC (pos); DEC (len)
    END; (* WHILE *)
    str [len2] := 0X;
  END
END Fill;


(*------------------------------------*)
PROCEDURE ToLower *
  (VAR str : ARRAY OF CHAR);

  VAR index : INTEGER; ch : CHAR;

BEGIN (* ToLower *)
  index := 0; ch := str [0];
  WHILE ch # 0X DO
    IF ((ch >= "A") & (ch <= "Z")) OR ((ch >= "À") & (ch <= "ß")) THEN
      ch := CHR (ORD (ch) + 32); str [index] := ch
    END;
    INC (index); ch := str [index]
  END;
END ToLower;

END Strings2.